home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Unsorted / ModuleOptimizer.AMOS / ModuleOptimizer.amosSourceCode
Encoding:
AMOS Source Code  |  1996-11-23  |  36.1 KB  |  1,465 lines
  1. ' *************************************
  2. ' *                                   *
  3. ' *     AMCAF File-Requester V1.0     *
  4. ' *      Written by Chris Hodges      *
  5. ' *                                   *
  6. ' *************************************
  7. '
  8. Set Buffer 40
  9. MXFILES=300
  10. Dim FIL$(MXFILES)
  11. '
  12. Dim FB(40,4),FB$(40)
  13. Global FB(),FB$()
  14. TH=8
  15. Global TH
  16. MAIN
  17. End 
  18. Procedure MAIN
  19.   Dim SAMS(31,3)
  20.   Gosub INIT
  21.   OMK=0 : REQS=1
  22.   Do 
  23.     Repeat : Multi Wait : Until Amos Here
  24.     If Timer>25
  25.       A$="}Chip: "+ Extension_8_0EB8(Chip Free/1024,4)+" KB  Fast: "+ Extension_8_0EB8(Fast Free/1024,5)+"KB "
  26.       TEX[300,0,614,10,A$]
  27.       Timer=0
  28.     End If 
  29.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  30.     BT=0
  31.     If MK=1 and OMK<>1
  32.       CHKMOUSE[XM,YM,25,40]
  33.       BT=Param
  34.     End If 
  35.     Exit If BT=25 or BT=32
  36.     If BT=27 Then Amos To Back 
  37.     If BT=28 Then Gosub LOAMOD
  38.     If BT=29 Then Gosub SAVMOD
  39.     If BT=30 Then Erase 9 : Gosub UPDATALL
  40.     If BT=31 Then Gosub ABOUT
  41.     If BT=33 Then Gosub OPTALL
  42.     If BT=34 Then Gosub OPTSAMPS
  43.     If BT=35 Then Gosub OPTSONG
  44.     If BT=36 Then Gosub OPTPATT
  45.     If BT=37 Then Gosub INFOSONG
  46.     OMK=MK
  47.   Loop 
  48.   Screen Close 0
  49. Pop Proc
  50. ABOUT:
  51.   REQUEST["Module Optimizer V0.1. Written by Chris Hodges.","Wow!"]
  52. Return 
  53. INFOSONG:
  54.    Extension_8_10C6 64
  55.    Extension_8_10D6 15
  56.    Extension_8_10F2 125
  57.    Extension_8_108E 9
  58.   REQUEST["Not yet implemented","Ooops"]
  59.    Extension_8_10A8 
  60. Return 
  61. OPTALL:
  62.   Gosub OPTSONG
  63.   Gosub OPTSAMPS
  64.   Gosub OPTPATT
  65. Return 
  66. OPTPATT:
  67.   DRAPROCBAR[38,0,1]
  68.   For A=0 To NPATTN-1
  69.     For AA=0 To NPATTN-1
  70.       If AA<>A
  71.         For B=0 To 255
  72.           Exit If Leek(ST+1084+A*1024+B*4)<>Leek(ST+1084+AA*1024+B*4)
  73.         Next 
  74.         If B=256
  75.           REQUEST["Pattern"+Str$(A)+" and"+Str$(AA)+" are the same.","Kill|Keep"]
  76.         End If 
  77.       End If 
  78.       DRAPROCBAR[38,AA+A*NPATTN+1,NPATTN*NPATTN]
  79.     Next 
  80.   Next 
  81.   SL=Peek(ST+950)
  82.   Reserve As Work 10,NPATTN*64
  83.   Erase 10
  84. Return 
  85. OPTSONG:
  86.   SL=Peek(ST+950)
  87.   DRAPROCBAR[38,0,1]
  88.   Do 
  89.     For A=0 To NPATTN-1
  90.       For AA=0 To 127
  91.         Exit If Peek(ST+952+AA)=A
  92.       Next 
  93.       If AA=128
  94.         For AA=0 To 255
  95.           Exit If Leek(ST+1084+A*1024+AA*4)
  96.         Next 
  97.         If AA<256 and REQS>0
  98.           Do 
  99.             REQUEST["Pattern"+Str$(A)+" not used.","Kill|Hear|Keep"]
  100.             P=Param
  101.             Exit If P=0 or P=2
  102.             OP=Peek(ST+952+SL)
  103.             Poke ST+950,SL+1
  104.             Poke ST+952+SL,A
  105.              Extension_8_109E 9,SL
  106.             Repeat 
  107.               Multi Wait 
  108.             Until Extension_8_10B6 =$FF
  109.              Extension_8_10A8 
  110.             Poke ST+950,SL
  111.             Poke ST+952+SL,OP
  112.           Loop 
  113.         Else 
  114.           P=0
  115.         End If 
  116.         If P=0
  117.           Copy ST+1084+(NPATTN-1)*1024,ST+1084+NPATTN*1024 To ST+1084+A*1024
  118.           Copy SAMS(1,0),SAMS(31,0)+SAMS(31,1) To SAMS(1,0)-1024
  119.           For AA=0 To 127
  120.             If Peek(ST+952+AA)=NPATTN-1
  121.               Poke ST+952+AA,A
  122.             End If 
  123.           Next 
  124.           Gosub UPDATINFO : A=-1 : Exit 
  125.         End If 
  126.       End If 
  127.       DRAPROCBAR[38,A+1,NPATTN]
  128.     Next 
  129.     Exit If A<>-1
  130.   Loop 
  131.   Reserve As Work 10,1024
  132.   AD=Start(10)
  133.   P=0
  134.   DRAPROCBAR[38,0,1]
  135.   M=0
  136.   For A=0 To 127
  137.     C=Peek(ST+952+A)
  138.     M=Max(M,C)
  139.     If A>0
  140.       For AA=0 To A-1
  141.         Exit If Peek(ST+952+AA)=C
  142.       Next 
  143.     Else 
  144.       AA=0
  145.     End If 
  146.     If AA=A
  147.       ADS=ST+1084+C*1024
  148.       Copy ST+1084+P*1024,ST+2108+P*1024 To AD
  149.       Copy ADS,ADS+1024 To ST+1084+P*1024
  150.       Copy AD,AD+1024 To ADS
  151.       For AA=0 To 127
  152.         B=Peek(ST+952+AA)
  153.         If B=P
  154.           Poke ST+952+AA,C
  155.         End If 
  156.         If B=C
  157.           Poke ST+952+AA,P
  158.         End If 
  159.       Next 
  160.       Inc P
  161.     End If 
  162.     DRAPROCBAR[38,A+1,128]
  163.   Next 
  164.   Erase 10
  165.   If M<NPATTN-1
  166.     Copy SAMS(0,0),SAMS(31,0)+SAMS(31,1) To ST+2108+NPATTN*1024
  167.   End If 
  168.   M=NPATTN
  169.   For A=SL To 127
  170.     Poke ST+952+A,0
  171.   Next 
  172.   Gosub UPDATALL
  173.   If M<NPATTN
  174.     Copy SAMS(0,0),SAMS(31,0)+SAMS(31,1) To ST+1084+NPATTN*1024
  175.   End If 
  176. Return 
  177. OPTSAMPS:
  178.   DRAPROCBAR[38,0,1]
  179.   For AA=1 To 31
  180.     If SAMS(AA,1)>0
  181.       If AD and 1 : Inc AD : End If 
  182.       If SAMS(AA,2)>0
  183.         NL=Min(SAMS(AA,0),SAMS(AA,2)+SAMS(AA,3))
  184.         If NL<SAMS(AA,1)
  185.           If SAMS(AA,0)+SAMS(AA,1)<SAMS(31,0)
  186.             Copy SAMS(AA,0)+SAMS(AA,1),SAMS(31,0)+SAMS(31,1) To SAMS(AA,0)+NL
  187.           End If 
  188.           Doke ST+12+AA*30,NL/2
  189.           Gosub UPDATINFO
  190.         End If 
  191.       End If 
  192.     End If 
  193.     DRAPROCBAR[38,AA,91]
  194.   Next 
  195.   For AA=1 To 31
  196.     If SAMS(AA,1)>0
  197.       P=0
  198.       For AD=SAMS(AA,0)+SAMS(AA,1)-1 To SAMS(AA,0)+1 Step -1
  199.         Add P,Abs( Extension_8_0BF0(AD))
  200.         Exit If P>8
  201.       Next 
  202.       If AD and 1 : Inc AD : End If 
  203.       NL=Max(AD-SAMS(AA,0),SAMS(AA,2)+SAMS(AA,3))
  204.       If NL<SAMS(AA,1)
  205.         If SAMS(AA,0)+SAMS(AA,1)<SAMS(31,0)
  206.           Copy SAMS(AA,0)+SAMS(AA,1),SAMS(31,0)+SAMS(31,1) To SAMS(AA,0)+NL
  207.         End If 
  208.         Doke ST+12+AA*30,NL/2
  209.         Gosub UPDATINFO
  210.       End If 
  211.     End If 
  212.     DRAPROCBAR[38,AA+31,91]
  213.   Next 
  214. '  For AA=1 To 31
  215. '    If SAMS(AA,1)>0 
  216. '      P=0 
  217. '      For AD=SAMS(AA,0)+4 To SAMS(AA,0)+SAMS(AA,1)-1
  218. '        Add P,Abs(Speek(AD))
  219. '        Exit If P>8 
  220. '      Next  
  221. '      If AD and 1 : Dec AD : End If 
  222. '      NL=SAMS(AA,1)-Min((AD-SAMS(AA,0)),SAMS(AA,2))+4 
  223. '      If NL<SAMS(AA,1)
  224. '        Copy SAMS(AA,0)+(SAMS(AA,1)-NL),SAMS(31,0)+SAMS(31,1) To SAMS(AA,0)+4 
  225. '        Doke ST+12+AA*30,NL/2 
  226. '        Doke ST+16+AA*30,(SAMS(AA,2)-(SAMS(AA,1)-NL))/2 
  227. '        Doke ST+18+AA*30,(SAMS(AA,2)-(SAMS(AA,1)-NL))/2 
  228. '        Gosub UPDATINFO 
  229. '      End If  
  230. '    End If  
  231. '    DRAPROCBAR[38,AA+62,91] 
  232. '  Next  
  233.   Reserve As Work 10,64
  234.   AD=ST+1084
  235.   For A=1 To NPATTN*256
  236.     IN=(Peek(AD) and $F0)+Peek(AD+2)/16 : Add AD,4
  237.     Doke Start(10)+IN*2,1
  238.   Next 
  239.   AD=Start(10)
  240.   For AA=1 To 31
  241.     If SAMS(AA,1)>0
  242.       If Deek(AD+AA*2)=0
  243.         If REQS
  244.           Do 
  245.             REQUEST["Sample"+Str$(AA)+" not in use.","Kill|Hear|Keep"]
  246.             P=Param
  247.             Exit If P=0 or P=2
  248.              Extension_8_1412 15,SAMS(AA,0),Max(SAMS(AA,1),258),15635
  249.           Loop 
  250.         Else 
  251.           P=0
  252.         End If 
  253.         If P=0
  254.           Doke ST+12+AA*30,0
  255.           Doke ST+14+AA*30,0
  256.           Doke ST+16+AA*30,0
  257.           Doke ST+18+AA*30,1
  258.           If SAMS(AA,0)+SAMS(AA,1)<SAMS(31,0)
  259.             Copy SAMS(AA,0)+SAMS(AA,1),SAMS(31,0)+SAMS(31,1) To SAMS(AA,0)
  260.           End If 
  261.           Gosub UPDATINFO
  262.         End If 
  263.       End If 
  264.     Else 
  265.       If Deek(AD+AA*2) and REQS
  266.         REQUEST["Warning: Sample"+Str$(AA)+" is used but non-existent!","Ooops!"]
  267.       End If 
  268.     End If 
  269.     DRAPROCBAR[38,AA+62,91]
  270.   Next 
  271.   Erase 10
  272.   Gosub UPDATALL
  273. Return 
  274. UPDATALL:
  275.   Gosub UPDATINFO
  276. Return 
  277. INIT:
  278.   Screen Open 0,640,256,4,$8000
  279.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  280.   Palette 0,$FFF,$AAA,$666
  281.   Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  282.   Screen Display 0,128,40,320,256
  283.   Gr Writing 0
  284.   Multi Wait : Limit Mouse 
  285.   DEFCLOWIN[25,0,0]
  286.   FILBOX[0,11,639,255,0]
  287.   DEFTEX[26,19,0,616,10,"{Module Optimizer V0.1",1]
  288.   DEFSCRTBK[27,617,0]
  289.   DEFTEX[28,4,13,100,24,"Load Module",1]
  290.   DEFTEX[29,4,26,100,37,"Save Module",1]
  291.   DEFTEX[30,4,39,100,50,"Unload Mod.",1]
  292.   DEFTEX[31,4,52,100,63,"About",1]
  293.   DEFTEX[32,4,65,100,76,"Quit Out!",1]
  294.   DEFTEX[33,102,13,240,24,"Optimize All",1]
  295.   DEFTEX[34,102,26,240,37,"Optimize Samples",1]
  296.   DEFTEX[35,102,39,240,50,"Optimize Song",1]
  297.   DEFTEX[36,102,52,240,63,"Optimize Pattern",1]
  298.   DEFTEX[37,102,65,240,76,"Info on Module",1]
  299.   DRABOX[243,13,635,76,1]
  300.   DEFBOX[38,247,64,631,74,4]
  301.   Gosub UPDATINFO
  302. Return 
  303. UPDATINFO:
  304.   If Length(9)
  305.     MN$=Peek$(Start(9),30,Chr$(0))
  306.     NPATTN=0
  307.     For A=0 To 127
  308.       P=Peek(ST+952+A)
  309.       If P>NPATTN : NPATTN=P : End If 
  310.     Next 
  311.     Inc NPATTN
  312.     NPATTL=NPATTN*1024
  313.     NSAMPN=0
  314.     NSAMPL=0
  315.     For A=1 To 31
  316.       P=Deek(ST+12+A*30)
  317.       SAMS(A,0)=ST+1084+NPATTL+NSAMPL
  318.       SAMS(A,1)=P*2
  319.       SAMS(A,2)=Deek(ST+16+A*30)*2
  320.       SAMS(A,3)=Deek(ST+18+A*30)*2
  321.       If P : Inc NSAMPN : Add NSAMPL,P*2 : End If 
  322.     Next 
  323.     NLENGTH=NPATTL+NSAMPL+1084
  324.     ACTGAD[29] : ACTGAD[30] : For A=33 To 37 : ACTGAD[A] : Next 
  325.   Else 
  326.     MN$="No file loaded."
  327.     NLENGTH=0 : NPATTN=0 : NPATTL=0 : NSAMPN=0 : NSAMPL=0
  328.     OLENGTH=0 : OPATTN=0 : OPATTL=0 : OSAMPN=0 : OSAMPL=0
  329.     DEAGAD[29] : DEAGAD[30] : For A=33 To 37 : DEAGAD[A] : Next 
  330.   End If 
  331.   TEX[246,14,632,23,"{Module loaded  : "+MN$]
  332.   TEX[246,22,632,31,"{Original length: "+ Extension_8_0EB8(OLENGTH,6)+"  New length     :"+ Extension_8_0EB8(NLENGTH,6)]
  333.   TEX[246,30,632,39,"{Num of samples : "+ Extension_8_0EB8(OSAMPN,2)+"      Num of samples :"+ Extension_8_0EB8(NSAMPN,2)]
  334.   TEX[246,38,632,47,"{Num of patterns: "+ Extension_8_0EB8(OPATTN,2)+"      Num of patterns:"+ Extension_8_0EB8(NPATTN,2)]
  335.   TEX[246,46,632,55,"{Samplelength   : "+ Extension_8_0EB8(OSAMPL,6)+"  Samplelength   :"+ Extension_8_0EB8(NSAMPL,6)]
  336.   TEX[246,54,632,63,"{Patternlength  : "+ Extension_8_0EB8(OPATTN*1024,6)+"  Patternlength  :"+ Extension_8_0EB8(NPATTN*1024,6)]
  337. Return 
  338. LOAMOD:
  339.   FILEREQ[-1,640,200,0,"Load a module",OFILE$,OPATH$,"","Load","Cancel","",""]
  340.   F$=Param$
  341.   If F$="" Then Return 
  342.   Trap Extension_8_0672 F$
  343.   If Errtrap
  344.     REQUEST["Error: "+ Extension_8_0522( Extension_8_0532 ),"Abort"]
  345.     Gosub UPDATALL
  346.     Return 
  347.   End If 
  348.   If Extension_8_0688 >0
  349.     REQS=0
  350.     Gosub MULTIFILE
  351.     REQS=1
  352.     Return 
  353.   End If 
  354.   Trap Extension_8_0456 F$,-9
  355.   If Errtrap
  356.     Erase 9
  357.     REQUEST["Error: "+ Extension_8_0522( Extension_8_0532 ),"Abort"]
  358.     Gosub UPDATALL
  359.     Return 
  360.   End If 
  361.   OPATH$= Extension_8_03E0(F$)
  362.   OFILE$= Extension_8_02F0(F$)
  363.   Gosub PROFILE
  364. Return 
  365. PROFILE:
  366.   ST=Start(9)
  367.   If Extension_8_0998("M.K.")<>Leek(ST+1080)
  368.     If REQS
  369.       REQUEST["WARNING!!! No Protracker-ID found! Proceed anyway?","Proceed|Abort"]
  370.     Else 
  371.       Erase 9 : Gosub UPDATALL
  372.       Return 
  373.     End If 
  374.     If Param=1
  375.       Erase 9
  376.       Gosub UPDATALL
  377.       Return 
  378.     End If 
  379.   End If 
  380.   OPATTN=0
  381.   For A=0 To 127
  382.     If(A and 8)=0 Then DRAPROCBAR[38,A+1,128]
  383.     P=Peek(ST+952+A)
  384.     If P>OPATTN Then OPATTN=P
  385.   Next 
  386.   Inc OPATTN
  387.   OPATTL=OPATTN*1024
  388.   OSAMPN=0 : OSAMPL=0
  389.   For A=1 To 31
  390.     DRAPROCBAR[38,A,31]
  391.     P=Deek(ST+12+A*30)
  392.     If P Then Inc OSAMPN : Add OSAMPL,P*2
  393.   Next 
  394.   OLENGTH=OPATTL+OSAMPL+1084
  395.   Gosub UPDATALL
  396. Return 
  397. MULTIFILE:
  398.   REQUEST["You have selected a directory. I assume that you want to process the whole directory.","Process|Cancel"]
  399.   If Param=1 Then Return 
  400.   FILEREQ[-1,640,200,0,"Enter target directory",OFILE$,OPATH$,"","Begin","Cancel","","DS"]
  401.   TD$=Param$
  402.   If TD$="" Then Return 
  403.   OPATH$= Extension_8_03E0(F$)
  404.   TD$= Extension_8_03E0(TD$)
  405.   SP=0
  406.    Extension_8_063A OPATH$
  407.   Do 
  408.     F$= Extension_8_064C 
  409.     Exit If F$=""
  410.     If Extension_8_0688 <0
  411.       Trap Extension_8_0456 Extension_8_03EC(OPATH$)+F$,9
  412.       If Errtrap=0
  413.         Gosub PROFILE
  414.         Gosub OPTALL
  415.         Trap Bsave Extension_8_03EC(TD$)+F$,ST To ST+NLENGTH
  416.         Add SP,OLENGTH-NLENGTH
  417.         Erase 9
  418.         Gosub UPDATALL
  419.       End If 
  420.     End If 
  421.   Loop 
  422.   REQUEST["Total space gained:"+Str$(SP)+" Bytes.","Yeah!"]
  423.   FILEREQNOTIFY
  424. Return 
  425. SAVMOD:
  426.   FILEREQ[-1,640,200,0,"Save the module",OFILE$,OPATH$,"","Save","Cancel","","S"]
  427.   F$=Param$
  428.   If F$="" Then Return 
  429.   Bsave F$,ST To ST+NLENGTH
  430.   FILEREQNOTIFY
  431. Return 
  432. End Proc
  433. Procedure FILEREQNOTIFY
  434.   Shared FIL$()
  435.   FIL$(0)=""
  436. End Proc
  437. Procedure FILEREQ[SN,SX,SY,YP,T$,F$,D$,PAT$,OK$,FAIL$,FON$,OP$]
  438.   Shared FIL$(),MXFILES
  439.   OTH=TH
  440.   Gosub INIT
  441.   Gosub SETUPSCREEN
  442.   Gosub REFRESH
  443.   Multi Wait : Limit Mouse 
  444.   OMK=0 : EXA=0 : ENT=0
  445.   Do 
  446.     If Timer>25 and RDIR=1
  447.       Sort FIL$(0)
  448.       Gosub REFRESH
  449.       Timer=0
  450.     End If 
  451.     Repeat 
  452.       If RDIR Then Gosub EXAMINDIR Else Multi Wait 
  453.     Until Amos Here
  454.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  455.     If MK=2 Then Gosub DEVLIST
  456.     If I$<>"" and ENT>0
  457.       STRGAD[ENT,I$]
  458.       If Param=-1
  459.         If ENT=6
  460.           F$=Mid$(FB$(6),2) : BT=4
  461.           FIL$(0)= Extension_8_08C4(FILOFF)+ Extension_8_08C4(MXNAMLEN)+RDIR$
  462.           Exit 
  463.         End If 
  464.         If ENT=7
  465.           DD$=D$
  466.           D$=Mid$(FB$(7),2)
  467.           If Exist(D$)
  468.             Gosub NEWREAD
  469.           Else 
  470.             REQUEST["Directory "+D$+" not found!","Oh sorry!"]
  471.             D$=DD$
  472.             NEWTEX[7,"{"+D$]
  473.           End If 
  474.         End If 
  475.         If ENT=8
  476.           PAT$=Mid$(FB$(8),2)
  477.           Gosub NEWREAD
  478.         End If 
  479.         ENT=0
  480.       End If 
  481.     End If 
  482.     BT=0
  483.     If MK=1 and OMK<>1
  484.       CHKMOUSE[XM,YM,1,15]
  485.       BT=Param
  486.     End If 
  487.     If BT and ENT Then NEWTEX[ENT,FB$(ENT)] : ENT=0
  488.     If BT=1 Then Gosub DRAGSCREEN
  489.     If BT=11 Then Gosub SELECT
  490.     If BT=2 or BT=4 or BT=5
  491.       If RDIR
  492.         FIL$(0)=""
  493.       Else 
  494.         FIL$(0)= Extension_8_08C4(FILOFF)+ Extension_8_08C4(MXNAMLEN)+RDIR$
  495.       End If 
  496.       Exit 
  497.     End If 
  498.     If BT=3 Then Amos To Back 
  499.     If BT>5 and BT<9 Then ENT=BT : STRGAD[BT,""]
  500.     If BT=9 Then Gosub DEVLIST
  501.     If BT=10 Then Gosub PARDIR
  502.     If BT=12 Then Gosub DRAGSLIDER
  503.     If BT=13 Then Gosub ARROWUP
  504.     If BT=14 Then Gosub ARROWDOWN
  505.     If BT=15 Then Gosub FLIPPAGE
  506.     OMK=MK
  507.   Loop 
  508.   Screen Close SN
  509.   For A=1 To 15
  510.     DISGAD[A]
  511.   Next 
  512.   If BT=4 Then A$= Extension_8_03EC(D$)+F$ Else A$=""
  513.   TH=OTH
  514.   Trap Limit Mouse 
  515. Pop Proc[A$]
  516. INIT:
  517.   If SN<0
  518.     For A=0 To 7
  519.       Trap Screen A
  520.       If Errtrap : SN=A : Exit : End If 
  521.     Next 
  522.   End If 
  523.   If T$="" Then T$="AMCAF File Selector"
  524.   If D$="" Then D$= Extension_8_03E0(Dir$)
  525.   If Instr(OP$,"P") Then PAT=1 Else PAT=0
  526.   If Instr(OP$,"R") Then FIL$(0)=""
  527.   If Instr(OP$,"D") Then DIONLY=1 Else DIONLY=0
  528.   If Instr(OP$,"Q") Then QUICK=1 Else QUICK=0
  529.   If Instr(OP$,"S") Then SAVREQ=1 Else SAVREQ=0
  530.   KICK=Deek(Leek(4)+20)
  531.   If KICK<37 Then PAT=0
  532.   SX=Max(Min((SX+15) and $FFE0,640),160)
  533.   SY=Max(Min(SY,256),96)
  534.   If YP<40 Then YP=168-SY/2
  535.   If FIL$(0)<>""
  536.     RDIR$=Mid$(FIL$(0),5)
  537.     If D$<>RDIR$
  538.       FIL$(0)=""
  539.       RDIR=1 : NUMFIL=0 : FILOFF=0 : SELFIL=-1
  540.       Return 
  541.     End If 
  542.     For A=1 To MXFILES
  543.       Exit If FIL$(A)=Chr$(255)
  544.     Next 
  545.     NUMFIL=A-1 : FILOFF= Extension_8_098C(FIL$(0))
  546.     MXNAMLEN= Extension_8_098C(Mid$(FIL$(0),3))
  547.     RDIR=0
  548.   Else 
  549.     RDIR=1 : NUMFIL=0 : FILOFF=0 : SELFIL=-1
  550.   End If 
  551. Return 
  552. SETUPSCREEN:
  553.   Screen Open SN,SX,SY,4,$8000
  554.   Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  555.   Palette 0,$FFF,$AAA,$666
  556.   Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  557.   Screen Display SN,288-SX/4,YP,SX,SY
  558.   If FON$<>""
  559.     A=Val(Left$(FON$,2))
  560.     If A>0
  561.       Trap Extension_8_05B0 Mid$(FON$,3),A
  562.       If Errtrap=0
  563.         TH=A
  564.       End If 
  565.     End If 
  566.   End If 
  567.   Gr Writing 0
  568.   DEFCLOWIN[2,0,0]
  569.   FILBOX[0,TH+3,SX-1,SY-1,0]
  570.   DEFTEX[1,19,0,SX-24,TH+2,"{"+T$,3]
  571.   DEFSCRTBK[3,SX-23,0]
  572.   A=Text Length("Pattern:")+8
  573.   If DIONLY=0
  574.     DEFTEX[6,A,SY-TH*2-9,SX-5,SY-TH-7,"{"+F$,7]
  575.     TEX[4,FB(6,1),FB(6,0),FB(6,3),"}File:"]
  576.     FY2=SY-TH*3-13
  577.   Else 
  578.     FY2=SY-TH*2-9
  579.   End If 
  580.   DEFTEX[7,A,FY2,SX-5,FY2+TH+2,"{"+D$,7]
  581.   TEX[4,FB(7,1),FB(7,0),FB(7,3),"}Dir:"]
  582.   If PAT
  583.     DEFTEX[8,A,FY2-TH-4,SX-5,FY2-2,"{"+PAT$,7]
  584.     TEX[4,FB(8,1),FB(8,0),FB(8,3),"}Pattern:"]
  585.     FY2=FB(8,1)-2
  586.   Else 
  587.     FY2=FB(7,1)-2
  588.   End If 
  589.   DEFTEX[4,4,SY-TH-5,SX/4-2,SY-3,OK$,1]
  590.   DEFTEX[9,SX/4+1,SY-TH-5,SX/2-3,SY-3,"Devices",1]
  591.   DEFTEX[10,SX/2,SY-TH-5,SX/2+SX/4-4,SY-3,"Parent",1]
  592.   If Right$(D$,1)=":" Then DEAGAD[10]
  593.   DEFTEX[5,SX/2+SX/4-1,SY-TH-5,SX-5,SY-3,FAIL$,1]
  594.   DEFARROWU[13,SX-22,FY2-17]
  595.   DEFARROWD[14,SX-22,FY2-8]
  596.   D=(FY2-TH-9)
  597.   MXLIN=D/TH
  598.   FY1=TH+7+(D-TH*MXLIN)/2
  599.   DEFBOX[15,SX-22,TH+5,SX-5,FY2-18,3]
  600.   DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  601. Return 
  602. PARDIR:
  603.   If Right$(D$,1)=":" Then Return 
  604.   If RDIR Then Extension_8_0660 
  605.   D$= Extension_8_03E0(D$)
  606.   Gosub NEWREAD
  607. Return 
  608. NEWREAD:
  609.   If RDIR Then Extension_8_0660 
  610.   NEWTEX[7,"{"+D$]
  611.   EXA=0 : RDIR=1 : Gosub EXAMINDIR
  612.   If Right$(D$,1)=":" Then DEAGAD[10] Else ACTGAD[10]
  613.   ACTGAD[9]
  614. Return 
  615. DEVLIST:
  616.   If RDIR=1 or Right$(FIL$(NUMFIL),1)=":" Then Return 
  617.   FILOFF=NUMFIL
  618.   F$=Dev First$("")
  619.   While NUMFIL<MXFILES and(F$<>"")
  620.     F$=Mid$(F$,2,Instr(F$,":")-1)
  621.     TYP= Extension_8_02D0(F$)
  622.     If TYP=0
  623.       MXNAMLEN=Max(MXNAMLEN,Len(F$))
  624.       Request Off 
  625.       Trap Extension_8_0672 F$
  626.       A=Errtrap
  627.       Request On 
  628.       If A=0
  629.         NAM$= Extension_8_06D8 
  630.         SOR$="A"+Upper$(F$)+Chr$(0)+"  <Dev> "+F$+Chr$(0)+" ("+NAM$+") "
  631.       Else 
  632.         SOR$="A"+Upper$(F$)+Chr$(0)+"  <Dev> "+F$+Chr$(0)+" "+ Extension_8_0522( Extension_8_0532 )
  633.       End If 
  634.       Inc NUMFIL
  635.       FIL$(NUMFIL)=SOR$
  636.     End If 
  637.     If TYP=1
  638.       MXNAMLEN=Max(MXNAMLEN,Len(F$))
  639.       Inc NUMFIL
  640.       FIL$(NUMFIL)="B"+Upper$(F$)+Chr$(0)+"  <Dir> "+F$+Chr$(0)+" Assign"
  641.     End If 
  642.     F$=Dev Next$
  643.   Wend 
  644.   Sort FIL$(0)
  645.   FILOFF=Min(FILOFF,NUMFIL-MXLIN)
  646.   Gosub REFRESH
  647.   DEAGAD[9]
  648. Return 
  649. SELECT:
  650.   Y=YM-FY1
  651.   If Y<0 or Y>=FY1+MXLIN*TH Then Return 
  652.   F=Y/TH+FILOFF+1
  653.   If F>NUMFIL Then Return 
  654.   TYP=Asc(FIL$(F))
  655.   A$=Peek$(Varptr(FIL$(F))+Instr(FIL$(F),Chr$(0))+8,40,Chr$(0))
  656.   If TYP=32
  657.     D$= Extension_8_03EC(D$)+A$
  658.     Gosub NEWREAD
  659.   End If 
  660.   If TYP=45
  661.     F$=A$
  662.     NEWTEX[6,"{"+F$]
  663.     If SELFIL<>F
  664.       If SELFIL-FILOFF=>0 and SELFIL-FILOFF<=MXLIN
  665.         A=SELFIL-FILOFF-1 : SELFIL=-1
  666.         Gosub LISTFILE
  667.       End If 
  668.       SELFIL=F : A=SELFIL-FILOFF-1 : Timer=0
  669.       Gosub LISTFILE
  670.     Else 
  671.       If Timer<50 and SAVREQ=0
  672.         BT=4
  673.       End If 
  674.     End If 
  675.   End If 
  676.   If TYP=65 or TYP=66
  677.     D$=A$ : Gosub NEWREAD
  678.   End If 
  679. Return 
  680. DRAGSCREEN:
  681.   PUSHGAD[BT]
  682.   A=YM
  683.   Limit Mouse X Hard(0),40+A To X Hard(SX-1),296-SY+A
  684.   Repeat 
  685.     If RDIR : Gosub EXAMINDIR : Else Multi Wait : End If 
  686.     YM=Y Screen(Y Mouse)-A : MK=Mouse Key : I$=Inkey$
  687.     Add YP,YM
  688.     Screen Display SN,,YP,,
  689.   Until MK<>1
  690.   Multi Wait : Limit Mouse 
  691.   OMK=1
  692.   RELEGAD[BT]
  693. Return 
  694. ARROWUP:
  695.   PUSHGAD[BT]
  696.   Repeat 
  697.     Multi Wait 
  698.     MK=Mouse Key : I$=Inkey$
  699.     If FILOFF>0
  700.       Dec FILOFF
  701.       Gosub SCROLFILES
  702.     End If 
  703.   Until MK<>1
  704.   RELEGAD[BT]
  705. Return 
  706. ARROWDOWN:
  707.   PUSHGAD[BT]
  708.   Repeat 
  709.     Multi Wait 
  710.     MK=Mouse Key : I$=Inkey$
  711.     If FILOFF<NUMFIL-MXLIN
  712.       Inc FILOFF
  713.       Gosub SCROLFILES
  714.     End If 
  715.   Until MK<>1
  716.   RELEGAD[BT]
  717. Return 
  718. DRAGSLIDER:
  719.   DISGAD[12]
  720.   O=YM-FB(12,1)
  721.   Repeat 
  722.     Multi Wait 
  723.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  724.     DRAGSLIDER[15,YM-O,MXLIN,NUMFIL,12]
  725.     If NUMFIL>MXLIN
  726.       FILOFF=Param
  727.       Gosub SCROLFILES
  728.     End If 
  729.   Until MK<>1
  730.   ENAGAD[12]
  731.   DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  732.   OMK=1
  733. Return 
  734. REFRESH:
  735.   DEFBOX[11,4,TH+5,SX-25,FY2,7]
  736.   If NUMFIL>0
  737.     For A=0 To Min(MXLIN-1,NUMFIL-1)
  738.       Gosub LISTFILE
  739.     Next 
  740.     OLDOFF=FILOFF
  741.   End If 
  742.   If FB(12,4) and 1 Then DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  743. Return 
  744. SCROLFILES:
  745.   If OLDOFF=FILOFF Then Return 
  746.   X1=FB(11,0)+2 : X2=FB(11,2)-2 : Y1=FY1+1 : Y2=FY1+TH*MXLIN+1
  747.   D=FILOFF-OLDOFF
  748.   If Abs(D)>MXLIN-2 Then Gosub REFRESH : Return 
  749.   If D>0
  750.     Screen Copy SN,X1,Y1+D*TH,X2,Y2 To SN,X1,Y1
  751.     For A=MXLIN-D To MXLIN-1
  752.       Gosub LISTFILE
  753.     Next 
  754.   Else 
  755.     Screen Copy SN,X1,Y1,X2,Y2+D*TH To SN,X1,Y1-D*TH
  756.     For A=0 To -D-1
  757.       Gosub LISTFILE
  758.     Next 
  759.   End If 
  760.   OLDOFF=FILOFF
  761.   If FB(12,4) and 1 Then DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  762. Return 
  763. FLIPPAGE:
  764.   If NUMFIL<MXLIN Then Return 
  765.   If YM>(FB(12,1)+FB(12,3))/2
  766.     FILOFF=Min(FILOFF+MXLIN,NUMFIL-MXLIN)
  767.   Else 
  768.     FILOFF=Max(FILOFF-MXLIN,0)
  769.   End If 
  770.   Gosub REFRESH
  771.   DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  772. Return 
  773. LISTFILE:
  774.   If QUICK
  775.     A$=FIL$(A+FILOFF+1)
  776.     A$=Peek$(Varptr(A$)+Instr(A$,Chr$(0)),40,Chr$(0))
  777.   Else 
  778.     A$=FIL$(A+FILOFF+1)
  779.     B$=Mid$(A$,Instr(A$,Chr$(0))+1)
  780.     FIL$=Left$(B$,Instr(B$,Chr$(0))-1)
  781.     RES$=Mid$(B$,Len(FIL$)+2)
  782.     A$=FIL$+Space$(MXNAMLEN-(Len(FIL$)-8))+RES$
  783.   End If 
  784.   If Asc(FIL$(A+FILOFF+1))<>45
  785.     TEX2[6,FY1+A*TH,SX-28,FY1+(A+1)*TH+1,"{"+A$]
  786.   Else 
  787.     TEX[6,FY1+A*TH,SX-28,FY1+(A+1)*TH+1,"{"+A$]
  788.   End If 
  789.   If A+FILOFF+1=SELFIL
  790.     Gr Writing 2
  791.     Ink 2 : Bar 8,FY1+A*TH+1 To SX-29,FY1+(A+1)*TH
  792.     Gr Writing 0
  793.   End If 
  794. Return 
  795. EXAMINDIR:
  796.   If EXA=0
  797.     FILOFF=0 : NUMFIL=0 : MXNAMLEN=5 : RDIR$=D$
  798.     SELFIL=-1
  799.     For A=1 To MXFILES
  800.       FIL$(A)=Chr$(255)
  801.     Next 
  802.     Trap Extension_8_063A D$
  803.     If Errtrap=0
  804.       EXA=1 : Timer=0
  805.     Else 
  806.       Gosub REFRESH
  807.       REQUEST[ Extension_8_0522( Extension_8_0532 )+"!","Cancel"]
  808.       RDIR=0 : Return 
  809.     End If 
  810.   End If 
  811.   If NUMFIL=MXFILES
  812.      Extension_8_0660 
  813.     Sort FIL$(0)
  814.     RDIR=0
  815.     Gosub REFRESH
  816.     Return 
  817.   End If 
  818.   FIL$= Extension_8_064C 
  819.   If FIL$=""
  820.     Sort FIL$(0)
  821.     Timer=0 : RDIR=0 : Gosub REFRESH
  822.     Return 
  823.   End If 
  824.   TYP= Extension_8_0688 
  825.   If QUICK=0
  826.     DATE$=Mid$( Extension_8_0F0A( Extension_8_06F4 ),4)+" "+ Extension_8_0F1A( Extension_8_070E )
  827.     COM$= Extension_8_0762 
  828.     FLAG$= Extension_8_0728( Extension_8_0742 )
  829.   End If 
  830.   If TYP<0
  831.     If DIONLY=0
  832.       If KICK>36
  833.         A= Extension_8_0300(FIL$,PAT$)
  834.       Else 
  835.         A=-1
  836.       End If 
  837.     Else 
  838.       A=0
  839.     End If 
  840.     If A
  841.       MXNAMLEN=Max(MXNAMLEN,Len(FIL$))
  842.       SIZE$= Extension_8_0EC8( Extension_8_06A2 ,7)
  843.       Inc NUMFIL
  844.       If QUICK
  845.         FIL$(NUMFIL)="-"+Upper$(FIL$)+Chr$(0)+SIZE$+" "+FIL$+Chr$(0)
  846.       Else 
  847.         SOR$="-"+Upper$(FIL$)+Chr$(0)+SIZE$+" "+FIL$+Chr$(0)+DATE$+" "+FLAG$+" "+COM$
  848.         FIL$(NUMFIL)=SOR$
  849.       End If 
  850.     End If 
  851.   Else 
  852.     MXNAMLEN=Max(MXNAMLEN,Len(FIL$))
  853.     Inc NUMFIL
  854.     If QUICK
  855.       FIL$(NUMFIL)=" "+Upper$(FIL$)+Chr$(0)+"  <Dir> "+FIL$+Chr$(0)
  856.     Else 
  857.       SOR$=" "+Upper$(FIL$)+Chr$(0)+"  <Dir> "+FIL$+Chr$(0)+DATE$+" "+FLAG$+" "+COM$
  858.       FIL$(NUMFIL)=SOR$
  859.     End If 
  860.   End If 
  861. Return 
  862. End Proc
  863. Procedure REQUEST[T$,OP$]
  864.   Dim LIN$(10)
  865.   OPT=1 : OTH=TH
  866.   For A=1 To Len(OP$)
  867.     If Mid$(OP$,A,1)="|" Then Inc OPT
  868.   Next 
  869.   If Screen=-1
  870.     TH=8
  871.     SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
  872.     LPR=SX/8-2
  873.   Else 
  874.     SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
  875.     LPR=SX/Text Length("M")-2
  876.   End If 
  877.   LI=0 : LP=1 : LILE=0
  878.   For A=1 To Len(T$)
  879.     P=Asc(Mid$(T$,A,1))
  880.     Inc LILE
  881.     If LILE>LPR
  882.       LIN$(LI)=Mid$(T$,LP,SP-LP+1)
  883.       LP=SP+2 : LILE=A-LP
  884.       Inc LI
  885.     End If 
  886.     If P=32 Then SP=A-1
  887.     If P=167 Then LILE=LPR+2 : SP=A-1
  888.   Next 
  889.   LIN$(LI)=Mid$(T$,LP) : Inc LI
  890.   NBLI=LI-1
  891.   SY=32+LI*TH
  892.   If Screen=-1
  893.     SN=0
  894.     Screen Open SN,SX,SY,4,$8000
  895.     Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  896.     Palette 0,$FFF,$AAA,$666
  897.     Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  898.     Screen Display SN,288-SX/4,168-SY/2,SX,SY
  899.     Gr Writing 0
  900.     Wait Vbl : Limit Mouse 
  901.     OLDSCR=-1
  902.     XP=0 : YP=0
  903.   Else 
  904.     If Screen Height<SY or Screen Width<SX or Screen Colour<4
  905.       For A=0 To 7
  906.         Trap Screen A
  907.         If Errtrap : SN=A : Exit : End If 
  908.       Next 
  909.       OLDSCR=Screen
  910.       Screen Open SN,SX,SY,4,$8000
  911.       Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  912.       Get Palette OLDSCR
  913.       Screen Display SN,288-SX/4,168-SY/2,SX,SY
  914.       Gr Writing 0
  915.       Wait Vbl : Limit Mouse 
  916.       XP=0 : YP=0
  917.     Else 
  918.       XP=(Screen Width-SX)/2
  919.       YP=(Screen Height-SY)/2
  920.       SN=-1
  921.       Get Cblock 9,XP-4,YP-2,SX+16,SY+4
  922.       DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
  923.       DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
  924.       Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
  925.     End If 
  926.   End If 
  927.   FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  928.   For A=0 To NBLI
  929.     TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  930.   Next 
  931.   OP=0
  932.   For A=1 To OPT
  933.     NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
  934.     T$=Mid$(OP$,OP+1,NP-OP-1)
  935.     X1=XP+4+((A-1)*(SX-6))/OPT
  936.     X2=XP+1+(A*(SX-6))/OPT
  937.     DEFTEX[15+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
  938.     OP=NP
  939.   Next 
  940.   OMK=0
  941.   Do 
  942.     Repeat : Multi Wait : Until Amos Here
  943.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  944.     BT=0
  945.     If MK=1 and OMK<>1
  946.       CHKMOUSE[XM,YM,16,15+OPT]
  947.       BT=Param
  948.     End If 
  949.     Exit If BT
  950.     OMK=MK
  951.   Loop 
  952.   For A=1 To OPT
  953.     DISGAD[15+A]
  954.   Next 
  955.   Limit Mouse 
  956.   If SN>-1
  957.     Screen Close SN
  958.     If OLDSCR>-1
  959.       Screen OLDSCR
  960.     End If 
  961.   Else 
  962.     Put Cblock 9
  963.     Del Cblock 9
  964.   End If 
  965.   TH=OTH
  966. End Proc[BT-16]
  967. Procedure NUMENT[T$,OP$,DEFNUM,LOWER,UPPER]
  968.   Dim LIN$(10)
  969.   OPT=1 : OTH=TH
  970.   For A=1 To Len(OP$)
  971.     If Mid$(OP$,A,1)="|" Then Inc OPT
  972.   Next 
  973.   If Screen=-1
  974.     TH=8
  975.     SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
  976.     LPR=SX/8-2
  977.   Else 
  978.     SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
  979.     LPR=SX/Text Length("M")-2
  980.   End If 
  981.   LI=0 : LP=1 : LILE=0
  982.   For A=1 To Len(T$)
  983.     P=Asc(Mid$(T$,A,1))
  984.     Inc LILE
  985.     If LILE>LPR
  986.       LIN$(LI)=Mid$(T$,LP,SP-LP+1)
  987.       LP=SP+2 : LILE=A-LP
  988.       Inc LI
  989.     End If 
  990.     If P=32 Then SP=A-1
  991.     If P=167 Then LILE=LPR+2 : SP=A-1
  992.   Next 
  993.   LIN$(LI)=Mid$(T$,LP) : Inc LI
  994.   NBLI=LI-1
  995.   SY=48+LI*TH
  996.   If Screen=-1
  997.     SN=0
  998.     Screen Open SN,SX,SY,4,$8000
  999.     Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1000.     Palette 0,$FFF,$AAA,$666
  1001.     Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  1002.     Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1003.     Gr Writing 0
  1004.     Wait Vbl : Limit Mouse 
  1005.     OLDSCR=-1
  1006.     XP=0 : YP=0
  1007.   Else 
  1008.     If Screen Height<SY or Screen Width<SX or Screen Colour<4
  1009.       For A=0 To 7
  1010.         Trap Screen A
  1011.         If Errtrap : SN=A : Exit : End If 
  1012.       Next 
  1013.       OLDSCR=Screen
  1014.       Screen Open SN,SX,SY,4,$8000
  1015.       Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1016.       Get Palette OLDSCR
  1017.       Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1018.       Gr Writing 0
  1019.       Wait Vbl : Limit Mouse 
  1020.       XP=0 : YP=0
  1021.     Else 
  1022.       XP=(Screen Width-SX)/2
  1023.       YP=(Screen Height-SY)/2
  1024.       SN=-1
  1025.       Get Cblock 9,XP-4,YP-2,SX+16,SY+4
  1026.       DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
  1027.       DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
  1028.       Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
  1029.     End If 
  1030.   End If 
  1031.   FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  1032.   For A=0 To NBLI
  1033.     TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  1034.   Next 
  1035.   DEFTEX[16,XP+4,YP+SY-TH*2-18,XP+SX-5,YP+SY-TH-16,"{"+Mid$(Str$(DEFNUM),2),7]
  1036.   OP=0
  1037.   For A=1 To OPT
  1038.     NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
  1039.     T$=Mid$(OP$,OP+1,NP-OP-1)
  1040.     X1=XP+4+((A-1)*(SX-6))/OPT
  1041.     X2=XP+1+(A*(SX-6))/OPT
  1042.     DEFTEX[16+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
  1043.     OP=NP
  1044.   Next 
  1045.   OMK=0
  1046.   STRGAD[16,""]
  1047.   Do 
  1048.     Repeat : Multi Wait : Until Amos Here
  1049.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1050.     BT=17
  1051.     If I$<>""
  1052.       If I$<" " or(I$>="0" and I$<="9")
  1053.         If Not(I$="0" and NUM=0)
  1054.           STRGAD[16,I$]
  1055.           Exit If Param=-1
  1056.         End If 
  1057.       End If 
  1058.     End If 
  1059.     NUM=Val(Mid$(FB$(16),2))
  1060.     If NUM<LOWER
  1061.       NUM=LOWER
  1062.       NEWTEX[16,"{"+Mid$(Str$(NUM),2)]
  1063.       STRGAD[16,""]
  1064.     End If 
  1065.     If NUM>UPPER
  1066.       NUM=UPPER
  1067.       NEWTEX[16,"{"+Mid$(Str$(NUM),2)]
  1068.       STRGAD[16,""]
  1069.     End If 
  1070.     BT=0
  1071.     If MK=1 and OMK<>1
  1072.       CHKMOUSE[XM,YM,16,16+OPT]
  1073.       BT=Param
  1074.     End If 
  1075.     Exit If BT>16
  1076.     OMK=MK
  1077.   Loop 
  1078.   For A=1 To OPT+1
  1079.     DISGAD[15+A]
  1080.   Next 
  1081.   Limit Mouse 
  1082.   If SN>-1
  1083.     Screen Close SN
  1084.     If OLDSCR>-1
  1085.       Screen OLDSCR
  1086.     End If 
  1087.   Else 
  1088.     Put Cblock 9
  1089.     Del Cblock 9
  1090.   End If 
  1091.   TH=OTH
  1092.   A$= Extension_8_0EB8(BT-17,1)+Mid$(Str$(NUM),2)
  1093. End Proc[A$]
  1094. Procedure TXTENT[T$,OP$,DEFTXT$,NUMLET]
  1095.   Dim LIN$(10)
  1096.   OPT=1 : OTH=TH
  1097.   For A=1 To Len(OP$)
  1098.     If Mid$(OP$,A,1)="|" Then Inc OPT
  1099.   Next 
  1100.   If Screen=-1
  1101.     TH=8
  1102.     SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
  1103.     LPR=SX/8-2
  1104.   Else 
  1105.     SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
  1106.     LPR=SX/Text Length("M")-2
  1107.   End If 
  1108.   LI=0 : LP=1 : LILE=0
  1109.   For A=1 To Len(T$)
  1110.     P=Asc(Mid$(T$,A,1))
  1111.     Inc LILE
  1112.     If LILE>LPR
  1113.       LIN$(LI)=Mid$(T$,LP,SP-LP+1)
  1114.       LP=SP+2 : LILE=A-LP
  1115.       Inc LI
  1116.     End If 
  1117.     If P=32 Then SP=A-1
  1118.     If P=167 Then LILE=LPR+2 : SP=A-1
  1119.   Next 
  1120.   LIN$(LI)=Mid$(T$,LP) : Inc LI
  1121.   NBLI=LI-1
  1122.   SY=48+LI*TH
  1123.   If Screen=-1
  1124.     SN=0
  1125.     Screen Open SN,SX,SY,4,$8000
  1126.     Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1127.     Palette 0,$FFF,$AAA,$666
  1128.     Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  1129.     Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1130.     Gr Writing 0
  1131.     Wait Vbl : Limit Mouse 
  1132.     OLDSCR=-1
  1133.     XP=0 : YP=0
  1134.   Else 
  1135.     If Screen Height<SY or Screen Width<SX or Screen Colour<4
  1136.       For A=0 To 7
  1137.         Trap Screen A
  1138.         If Errtrap : SN=A : Exit : End If 
  1139.       Next 
  1140.       OLDSCR=Screen
  1141.       Screen Open SN,SX,SY,4,$8000
  1142.       Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1143.       Get Palette OLDSCR
  1144.       Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1145.       Gr Writing 0
  1146.       Wait Vbl : Limit Mouse 
  1147.       XP=0 : YP=0
  1148.     Else 
  1149.       XP=(Screen Width-SX)/2
  1150.       YP=(Screen Height-SY)/2
  1151.       SN=-1
  1152.       Get Cblock 9,XP-4,YP-2,SX+16,SY+4
  1153.       DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
  1154.       DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
  1155.       Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
  1156.     End If 
  1157.   End If 
  1158.   FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  1159.   For A=0 To NBLI
  1160.     TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  1161.   Next 
  1162.   DEFTEX[16,XP+4,YP+SY-TH*2-18,XP+SX-5,YP+SY-TH-16,"{"+DEFTXT$,7]
  1163.   OP=0
  1164.   For A=1 To OPT
  1165.     NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
  1166.     T$=Mid$(OP$,OP+1,NP-OP-1)
  1167.     X1=XP+4+((A-1)*(SX-6))/OPT
  1168.     X2=XP+1+(A*(SX-6))/OPT
  1169.     DEFTEX[16+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
  1170.     OP=NP
  1171.   Next 
  1172.   OMK=0
  1173.   STRGAD[16,""]
  1174.   Do 
  1175.     Repeat : Multi Wait : Until Amos Here
  1176.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1177.     BT=17
  1178.     If I$<>""
  1179.       STRGAD[16,I$]
  1180.       Exit If Param=-1
  1181.     End If 
  1182.     TXT$=Mid$(FB$(16),2)
  1183.     If Len(TXT$)>NUMLET
  1184.       NEWTEX[16,"{"+Left$(TXT$,NUMLET)]
  1185.       STRGAD[16,""]
  1186.     End If 
  1187.     BT=0
  1188.     If MK=1 and OMK<>1
  1189.       CHKMOUSE[XM,YM,16,16+OPT]
  1190.       BT=Param
  1191.     End If 
  1192.     Exit If BT>16
  1193.     OMK=MK
  1194.   Loop 
  1195.   For A=1 To OPT+1
  1196.     DISGAD[15+A]
  1197.   Next 
  1198.   Limit Mouse 
  1199.   If SN>-1
  1200.     Screen Close SN
  1201.     If OLDSCR>-1
  1202.       Screen OLDSCR
  1203.     End If 
  1204.   Else 
  1205.     Put Cblock 9
  1206.     Del Cblock 9
  1207.   End If 
  1208.   TH=OTH
  1209.   A$= Extension_8_0EB8(BT-17,1)+TXT$
  1210. End Proc[A$]
  1211. Procedure CHKMOUSE[XM,YM,LL,UL]
  1212.   For BT=LL To UL
  1213.     If XM=>FB(BT,0) and XM<=FB(BT,2) and YM=>FB(BT,1) and YM<=FB(BT,3) and(FB(BT,4) and 1) Then Exit 
  1214.   Next 
  1215.   If BT>UL Then Pop Proc[0]
  1216.   If FB(BT,4) and 2 Then Pop Proc[BT]
  1217.   OST=-1 : AA=0
  1218.   ST= Extension_8_093A(FB(BT,4) and 4,2)
  1219.   Repeat 
  1220.     Multi Wait 
  1221.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1222.     If XM=>FB(BT,0) and XM<=FB(BT,2) and YM=>FB(BT,1) and YM<=FB(BT,3) Then A=1 Else A=0
  1223.     If AA<>A Then AA=A : ST=1-ST
  1224.     If OST<>ST
  1225.       If ST
  1226.         PUSHGAD[BT]
  1227.       Else 
  1228.         RELEGAD[BT]
  1229.       End If 
  1230.       OST=ST
  1231.     End If 
  1232.   Until MK<>1
  1233.   If A=0 Then Pop Proc[0]
  1234.   If ST
  1235.     RELEGAD[BT]
  1236.   Else 
  1237.     PUSHGAD[BT]
  1238.   End If 
  1239. End Proc[BT]
  1240. Procedure DEFTEX[BT,X1,Y1,X2,Y2,T$,FL]
  1241.   TEXBOX[X1,Y1,X2,Y2, Extension_8_093A(FL and 4,2),T$]
  1242.   DEFGAD[BT,X1,Y1,X2,Y2,FL]
  1243.   FB$(BT)=T$
  1244. End Proc
  1245. Procedure DEFBOX[BT,X1,Y1,X2,Y2,FL]
  1246.   FILBOX[X1,Y1,X2,Y2, Extension_8_093A(FL and 4,2)]
  1247.   DEFGAD[BT,X1,Y1,X2,Y2,FL]
  1248. End Proc
  1249. Procedure DEFGAD[BT,X1,Y1,X2,Y2,FL]
  1250.   FB(BT,0)=X1 : FB(BT,1)=Y1
  1251.   FB(BT,2)=X2 : FB(BT,3)=Y2
  1252.   FB(BT,4)=FL
  1253.   FB$(BT)=""
  1254. End Proc
  1255. Procedure DEAGAD[BT]
  1256.   If(FB(BT,4) and 1)=0 Then Pop Proc
  1257.   FB(BT,4)=FB(BT,4) and $FE
  1258.   Set Pattern 2
  1259.   Ink 3 : Bar FB(BT,0),FB(BT,1) To FB(BT,2),FB(BT,3)
  1260.   Set Pattern 0
  1261. End Proc
  1262. Procedure ACTGAD[BT]
  1263.   If FB(BT,4) and 1 Then Pop Proc
  1264.   CLRGAD[BT]
  1265.   FB(BT,4)=FB(BT,4) or 1
  1266.   If FB$(BT)<>""
  1267.     TEXBOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3), Extension_8_093A(FB(BT,4) and 4,2),FB$(BT)]
  1268.   Else 
  1269.     DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3), Extension_8_093A(FB(BT,4) and 4,2)]
  1270.   End If 
  1271. End Proc
  1272. Procedure DISGAD[BT]
  1273.   FB(BT,4)=FB(BT,4) and $FE
  1274. End Proc
  1275. Procedure ENAGAD[BT]
  1276.   FB(BT,4)=FB(BT,4) or 1
  1277. End Proc
  1278. Procedure CLRGAD[BT]
  1279.   FB(BT,4)=FB(BT,4) and $FE
  1280.   Ink 2 : Bar FB(BT,0),FB(BT,1) To FB(BT,2),FB(BT,3)
  1281. End Proc
  1282. Procedure PUSHGAD[BT]
  1283.   DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3),1]
  1284. End Proc
  1285. Procedure RELEGAD[BT]
  1286.   DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3),0]
  1287. End Proc
  1288. Procedure FILBOX[X1,Y1,X2,Y2,SE]
  1289.   Ink 2 : Bar X1+2,Y1+1 To X2-2,Y2-1
  1290.    Extension_8_0388 X1,Y2,2
  1291.    Extension_8_0388 X2,Y1,2
  1292.   Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  1293.   Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
  1294. End Proc
  1295. Procedure NEWTEX[BT,T$]
  1296.   FB$(BT)=T$
  1297.   TEX[FB(BT,0)+1,FB(BT,1),FB(BT,2)-1,FB(BT,3),T$]
  1298. End Proc
  1299. Procedure TEXBOX[X1,Y1,X2,Y2,SE,T$]
  1300.   TEX[X1+1,Y1,X2-1,Y2,T$]
  1301.    Extension_8_0388 X1,Y2,2 : Extension_8_0388 X2,Y1,2
  1302.   Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  1303.   Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
  1304. End Proc
  1305. Procedure TEX[X1,Y1,X2,Y2,T$]
  1306.   If Asc(T$)=123
  1307.     M=1 : T$=Mid$(T$,2)
  1308.   Else 
  1309.     If Asc(T$)=125
  1310.       M=2 : T$=Mid$(T$,2)
  1311.     Else 
  1312.       M=0
  1313.     End If 
  1314.   End If 
  1315.   TL=Text Length(T$)
  1316.   While TL>(X2-X1)-4
  1317.     T$=Left$(T$,Len(T$)-1)
  1318.     TL=Text Length(T$)
  1319.   Wend 
  1320.   If M=1
  1321.     X=X1+4 : Y=Y1+1
  1322.   Else 
  1323.     If M=2
  1324.       X=X2-Text Length(T$)-2 : Y=Y1+1
  1325.     Else 
  1326.       X=(X1+X2-TL)/2 : Y=(Y1+Y2-TH+1)/2
  1327.     End If 
  1328.   End If 
  1329.   If Y2>0 Then Ink 2 : Bar X1+1,Y1+1 To X2-1,Y2-1
  1330.   Ink 0 : Text X,Y+Text Base,T$
  1331. End Proc
  1332. Procedure TEX2[X1,Y1,X2,Y2,T$]
  1333.   If Asc(T$)=123
  1334.     M=1 : T$=Mid$(T$,2)
  1335.   Else 
  1336.     If Asc(T$)=125
  1337.       M=2 : T$=Mid$(T$,2)
  1338.     Else 
  1339.       M=0
  1340.     End If 
  1341.   End If 
  1342.   TL=Text Length(T$)
  1343.   While TL>(X2-X1)-4
  1344.     T$=Left$(T$,Len(T$)-1)
  1345.     TL=Text Length(T$)
  1346.   Wend 
  1347.   If M=1
  1348.     X=X1+4 : Y=Y1+1
  1349.   Else 
  1350.     If M=2
  1351.       X=X2-Text Length(T$)-2 : Y=Y1+1
  1352.     Else 
  1353.       X=(X1+X2-TL)/2 : Y=(Y1+Y2-TH+1)/2
  1354.     End If 
  1355.   End If 
  1356.   If Y2>0 Then Ink 2 : Bar X1+1,Y1+1 To X2-1,Y2-1
  1357.   Ink 1 : Text X,Y+Text Base,T$
  1358. End Proc
  1359. Procedure DRABOX[X1,Y1,X2,Y2,SE]
  1360.   Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  1361.   Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
  1362. End Proc
  1363. Procedure STRGAD[BT,I$]
  1364.   Shared POS
  1365.   A$=FB$(BT)
  1366.   If I$=""
  1367.     POS=Len(A$)-1
  1368.   End If 
  1369.   If I$>Chr$(31) Then A$=Left$(A$,POS+1)+I$+Mid$(A$,POS+2) : Inc POS
  1370.   If I$=Chr$(8) and POS>0 Then A$=Left$(A$,POS)+Mid$(A$,POS+2) : Dec POS
  1371.   If I$=Cleft$ and POS>0 Then Dec POS
  1372.   If I$=Cright$ and POS<Len(A$)-1 Then Inc POS
  1373.   If I$=Chr$(13)
  1374.     NEWTEX[BT,A$]
  1375.     Pop Proc[-1]
  1376.   End If 
  1377.   NEWTEX[BT,A$]
  1378.   X1=FB(BT,0)+5+Text Length(Mid$(A$,2,POS)) : Y1=FB(BT,1)+1
  1379.   X2=X1+Max(Text Length(Mid$(A$,POS+2,1)),4)
  1380.   If X2<FB(BT,2)-4
  1381.     Gr Writing 2
  1382.     Ink 3 : Bar X1,Y1 To X2-1,Y1+TH-1
  1383.     Gr Writing 0
  1384.   End If 
  1385. End Proc[0]
  1386. Procedure DEFCLOWIN[BT,X,Y]
  1387.   DRACLOWIN[X,Y]
  1388.   DEFGAD[BT,X,Y,X+18,Y+TH+2,1]
  1389. End Proc
  1390. Procedure DRACLOWIN[X,Y]
  1391.   FILBOX[X,Y,X+18,Y+TH+2,0]
  1392.   Ink 0 : Box 7+X,3+Y To 11+X,Y+TH-1
  1393. End Proc
  1394. Procedure DEFSCRTBK[BT,X,Y]
  1395.   DRASCRTBK[X,Y]
  1396.   DEFGAD[BT,X,Y,X+22,Y+TH+2,1]
  1397. End Proc
  1398. Procedure DRASCRTBK[X,Y]
  1399.   FILBOX[X,Y,X+22,Y+TH+2,0]
  1400.   Ink 0 : Box 4+X,2+Y To 14+X,Y+TH/2+2
  1401.   Ink 2 : Bar 8+X,Y+TH/2 To 18+X,Y+TH
  1402.   Ink 0 : Box 8+X,Y+TH/2 To 18+X,Y+TH
  1403. End Proc
  1404. Procedure DEFARROWU[BT,X,Y]
  1405.   DRAARROWU[X,Y]
  1406.   DEFGAD[BT,X,Y,X+17,Y+8,3]
  1407. End Proc
  1408. Procedure DRAARROWU[X,Y]
  1409.   DRABOX[X,Y,X+17,Y+8,0]
  1410.    Extension_8_1016 X+4,Y+6 To X+8,Y+2,0
  1411.    Extension_8_1016 X+5,Y+6 To X+8,Y+3,0
  1412.    Extension_8_1016 X+9,Y+2 To X+13,Y+6,0
  1413.    Extension_8_1016 X+9,Y+3 To X+12,Y+6,0
  1414. End Proc
  1415. Procedure DEFARROWD[BT,X,Y]
  1416.   DRAARROWD[X,Y]
  1417.   DEFGAD[BT,X,Y,X+17,Y+8,3]
  1418. End Proc
  1419. Procedure DRAARROWD[X,Y]
  1420.   DRABOX[X,Y,X+17,Y+8,0]
  1421.    Extension_8_1016 X+4,Y+2 To X+8,Y+6,0
  1422.    Extension_8_1016 X+5,Y+2 To X+8,Y+5,0
  1423.    Extension_8_1016 X+9,Y+6 To X+13,Y+2,0
  1424.    Extension_8_1016 X+9,Y+5 To X+12,Y+2,0
  1425. End Proc
  1426. Procedure DRAPROCBAR[BT,POS,MX]
  1427.   X1=FB(BT,0)+2 : X2=FB(BT,2)-2 : Y1=FB(BT,1)+1 : Y2=FB(BT,3)-1
  1428.   DX=X2-X1
  1429.   PX=X1+(POS*DX)/MX
  1430.   If PX>X1 and PX<X2
  1431.     Ink 0 : Bar X1,Y1 To PX,Y2
  1432.     Ink 2 : Bar PX,Y1 To X2,Y2
  1433.   End If 
  1434.   If PX=X1 Then Ink 2 : Bar X1,Y1 To X2,Y2
  1435.   If PX=X2 Then Ink 0 : Bar X1,Y1 To X2,Y2
  1436. End Proc
  1437. Procedure DRASLIDER[BT,LINOFF,PAG,NUMLIN,NB]
  1438.   D=(FB(BT,3)-FB(BT,1))-4
  1439.   Y1=(LINOFF*D)/Max(NUMLIN,PAG)+FB(BT,1)+2
  1440.   Y2=((LINOFF+PAG)*D)/Max(NUMLIN,PAG)+FB(BT,1)+2
  1441.   DEFGAD[NB,FB(BT,0)+4,Y1,FB(BT,2)-4,Y2,3]
  1442.   Ink 2
  1443.   If Y1>FB(BT,1)+2 Then Bar FB(BT,0)+4,FB(BT,1)+1 To FB(BT,2)-4,Y1-1
  1444.   If Y2<FB(BT,3)-2 Then Bar FB(BT,0)+4,Y2+1 To FB(BT,2)-4,FB(BT,3)-1
  1445.   If Y2-Y1>0
  1446.     Ink 0 : Bar FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2
  1447.   Else 
  1448.      Extension_8_1016 FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2,0
  1449.   End If 
  1450. End Proc
  1451. Procedure DRAGSLIDER[BT,Y,PAG,NUMLIN,NB]
  1452.   Y1=FB(NB,1) : Y2=FB(NB,3) : D=Y2-Y1
  1453.   Y1=Min(Max(FB(BT,1)+2,Y),FB(BT,3)-2-D)
  1454.   Y2=Y1+D : FB(NB,1)=Y1 : FB(NB,3)=Y2
  1455.   Ink 2
  1456.   If Y1>FB(BT,1)+2 Then Bar FB(BT,0)+4,FB(BT,1)+1 To FB(BT,2)-4,Y1-1
  1457.   If Y2<FB(BT,3)-2 Then Bar FB(BT,0)+4,Y2+1 To FB(BT,2)-4,FB(BT,3)-1
  1458.   If Y2-Y1>0
  1459.     Ink 1 : Bar FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2
  1460.   Else 
  1461.      Extension_8_1016 FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2,1
  1462.   End If 
  1463.   D=FB(BT,3)-FB(BT,1)-4
  1464.   L=Min(((Y1-FB(BT,1)-2)*Max(NUMLIN,PAG)+D/2)/D,NUMLIN-PAG)
  1465. End Proc[L]